perm filename COUNT[AP,SYS] blob sn#000463 filedate 1972-10-02 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00007 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	DEFINITIONS
 00003 00003	STORAGE ALLOCATIONS
 00005 00004	BEGIN OF MAIN PROGRAM
 00007 00005	BEGIN COUNTING SAME WORD, DIFFERENT STORY
 00013 00006	OUTFIL:	OPEN	3,DSK17			prepare to write out CNTD file
 00015 00007	GETDCT:	JUMPLE	KPTR,PLAINW
 00017 ENDMK
⊗;
;DEFINITIONS
	TITLE COUNT
A←←1			;temporary reg
DPTR←←2			;pointer into DICT
NUMBER←←3			;counter of number of stories for word
C←←4			;CAREFUL WHEN DIVIDING
WPTR←←5			;pointer into WORDS
PT2←←6
PT1←←7			;pointer into DICT
CPTR←←10		;pointer into CNTD
B←←11			;temporary reg
CNT←←12
TPTR←←13		;pointer into TCOUNT
B←←14
KPTR←←15
RPTR←←16
P←←17

PDLEN←←10
WLEN←←6400
DLEN←←6000
LLEN←←10000
TLEN←←14000		;length of TCOUNT
CLEN←←DLEN/2		;length of CNTD

DEFINE	ERRMSG(MSG)
	{PUSHJ	P,[	MOVEM	A,SAVEDA
			MOVEI	A,[ASCIZ \MSG\]
			JRST	ERROR]}
;STORAGE ALLOCATIONS

WORDSF:	SIXBIT	/WORDS/
	BLOCK	3

TCNTF:	SIXBIT	/OCCUR/
	SIXBIT	/TXT/
	BLOCK	2

LINKSF:	SIXBIT	/LINKS/
	BLOCK	3

DICTF:	SIXBIT	/DICT/
	BLOCK	3

COUNTF:	SIXBIT	/OCCUR/
	SIXBIT	/DAT/
	BLOCK	2

MULKY:	BLOCK	=10
WORDS:	BLOCK	WLEN
TCOUN:	BLOCK	TLEN
CNTD:	BLOCK	CLEN
DICT:	BLOCK	DLEN
PDLST:	BLOCK	PDLEN
LINKS:	BLOCK	LLEN

LCMD:	IOWD	LLEN,LINKS
	0
DCMD:	IOWD	DLEN,DICT
	0
CMD:	IOWD	CLEN,CNTD
	0
WCMD:	IOWD	WLEN,WORDS
	0
TCMD:	IOWD	TLEN,TCOUN
	0

DSK17:	17
	SIXBIT	/DSK/
	0

MASK:	7700000
SAVEDA:	0
MASK2:	7737576
MASK4:	001767737576
STARS:	251245225022
SPACES:	100402010040
;BEGIN OF MAIN PROGRAM
COUNTR:	MOVE	P,[IOWD PDLEN,PDLST]

AGAIN1:	OPEN	2,DSK17		;read in DICT
	ERRMSG	{OPEN FAILED ON DICT PAGE 4}
	SETZM	DICTF+3
	LOOKUP	2,DICTF
	JRST	[RELEAS 2,
		 MOVEI	A,1
		 CALL	A,[SIXBIT /SLEEP/]
		 JRST	AGAIN1]
	HLRE	A,DICTF+3		;get size of DICT file
	CAMGE	A,[-DLEN]
	ERRMSG	{DICT BIGGER THAN IN CORE BUFFER}
	HRLM	A,DCMD			;put size into dump mode command
	IN	2,DCMD
	JRST	.+2
	ERRMSG	{IN FAILED ON DICT PAGE 4}

	OPEN	4,DSK17			;open the WORDS file in preparation for
	ERRMSG	{OPEN FAILED ON WORDS PAGE 5}	;the TCOUNT file
	SETZM	WORDSF+3
	LOOKUP	4,WORDSF
	ERRMSG	{LOOKUP FAILED ON WORDS}
	IN	4,WCMD
	JRST	.+2
	ERRMSG	{IN FAILED ON WORDS PAGE 5}
	RELEAS	4,

	OPEN	1,DSK17		;read in the LINKS
	ERRMSG	{OPEN FAILED ON LINKS PAGE 4}
	SETZM	LINKSF+3
	LOOKUP	1,LINKSF
	ERRMSG	{LOOKUP FAILED ON LINKS PAGE 4}
	IN	1,LCMD
	JRST	.+2
	ERRMSG	{IN FAILED ON LINKS PAGE 4}

	RELEAS	1,
	RELEAS	2,

	OPEN	3,DSK17		;here we check to see if there is a CNTD
	ERRMSG  {OPEN FAILED ON COUNT PAGE 4}
	SETZM	COUNTF+3
	LOOKUP	3,COUNTF
	JRST	STRT		;no..go make one
	IN	3,CMD		;yes there is a CNTD. Continue
	JRST	STRT
	ERRMSG	{IN FAILED ON COUNT PAGE 4}
;BEGIN COUNTING SAME WORD, DIFFERENT STORY

STRT:	MOVEI	CPTR,1
	SETZ	DPTR,
	SETZ	TPTR,			;beginning of TCOUNT
	SETZ	RPTR,
	SETZ	KPTR,
RESTRT:	HRRZ	NUMBER,CNTD(CPTR)		;get the previous count
	PUSHJ	P,GETDCT
	HRRZ	A,MULKY(KPTR)	;get the pointer from DICT into WORDs
	CAIN	A,2140
TEST:	JRST	.+1
BEG:	HRRZ	B,DICT+1(A)		;get the pointer into the LINKS area
	JUMPE	B,DONE			;if it's zero, no
BACK:	MOVE	A,B
	ADDI	NUMBER,1			;found another story with that word
	HLRZ	B,LINKS(A)		;get same word different story pointer
	CAME	B,A			;CLUGE TO MAKE IT WORK WHEN LINKS POINT TO ITSELF
	JUMPN	B,BACK			;any more stories?
DONE:	HRRM	NUMBER,CNTD(CPTR)		;store the number of stories found int CNTD

	MOVE	A,SPACES
	TRZ	A,40
	MOVEI	NUMBER+1,11
	ADDI	A,(NUMBER+1)
	CAIGE	NUMBER,=10000
	JRST	ONWARD
	MOVE	A,STARS
	JRST	RDUN5
ONWARD:	IDIVI	NUMBER,=10
	ADDI	NUMBER+1,60
	ROT	A,-7
	TRZ	A,40
	ADDI	A,(NUMBER+1)
	JUMPE	NUMBER,RDUN4
	IDIVI	NUMBER,=10
	ADDI	NUMBER+1,60
	ROT	A,-7
	TRZ	A,40
	ADDI	A,(NUMBER+1)
	JUMPE	NUMBER,RDUN3
	ROT	A,-7
	IDIVI	NUMBER,=10
	ADDI	NUMBER+1,60
	TRZ	A,40
	ADDI	A,(NUMBER+1)
	JUMPE	NUMBER,RDUN0
	ADDI	NUMBER,60
	ROT	A,-7
	TRZ	A,40
	ADDI	A,(NUMBER)
	ROT	A,7
RDUN0:	ROT	A,7
RDUN3:	ROT	A,7
RDUN4:	ROT	A,7
	LSH	A,1
RDUN5:	MOVEM	A,TCOUN(TPTR)
	ADDI	TPTR,1

NXTWRD:	MOVE	PT1,MULKY(RPTR)		;get first word of first WORD
	HLRZ	PT1,DICT(PT1)
	MOVE	A,WORDS(PT1)
	TRNN	A,176			;does it end in @ signs?
	JRST	RES1			;yes
	MOVEM	A,TCOUN(TPTR)		;no. move it into TCOUN
	ADDI	TPTR,1
	MOVE	A,WORDS+1(PT1)		;get next word(remember,DICT and WORDs are the same area)
	TRNN	A,176			;etc.
	JRST	RES1
	MOVEM	A,TCOUN(TPTR)
	ADDI	TPTR,1
	MOVE	A,WORDS+2(PT1)
	TRNN	A,176
	JRST	RES1
	MOVEM	A,TCOUN(TPTR)
	ADDI	TPTR,1
	MOVE	A,WORDS+3(PT1)

RES1:	TRNE	A,176			;here we get rid of the @ signs at the end
	JRST	CON			;of the keywords.We start by checking if the
	TRZ	A,376
	TRO	A,100
	TRNE	A,37400			;null byte and then move on to the previous 
	JRST	CON			;byte.
	TRZ	A,40000
	TDNE	A,MASK
	JRST	CON
	TLZ	A,10
	TLNE	A,1760
	JRST	CON
	TLZ	A,2000
	TLNE	A,374000
	JRST	CON
	TLZ	A,400000

CON:	MOVEM	A,TCOUN(TPTR)		;store the last part of the keyword, without @'s
	ADDI	TPTR,1
	CAME	RPTR,KPTR
	AOJA	RPTR,NXTWRD
	SETZ	RPTR,
	MOVEI	A,6424
	MOVEM	A,TCOUN(TPTR)
	ADDI	TPTR,1			;advance all pointers
ADV:	AOJA	CPTR,RESTRT
OUTFIL:	OPEN	3,DSK17			;prepare to write out CNTD file
	ERRMSG	{OPEN FAILED ON COUNT PAGE 5}
	HLLZS	COUNTF+1
	SETZM	COUNTF+2
	SETZM	COUNTF+3
	ENTER	3,COUNTF
	ERRMSG	{ENTER FAILED ON COUNT PAGE 5}
	OUT	3,CMD
	JRST	.+2
	ERRMSG	{OUT FAILED ON COUNT PAGE 5}
	RELEAS	3,

	OPEN	5,DSK17			;prepare to write out TCOUNT
	ERRMSG	{OPEN ON OCCUR.TXT FAILED PAGE 7}
	HLLZS	TCNTF+1
	SETZM	TCNTF+2
	SETZM	TCNTF+3
	ENTER	5,TCNTF
	ERRMSG	{ENTER FAILED PAGE 7 ON OCCUR.TXT}
	OUT	5,TCMD
	JRST	.+2
	ERRMSG	{OUT FAILED ON OCCUR.TXT PAGE 7}
	RELEAS 	5,
	CALL	[SIXBIT /EXIT/]

ERROR:	OUTSTR	[CRLFS:	ASCIZ /

/]
	OUTSTR	(A)
	OUTSTR	CRLFS
	MOVE	A,SAVEDA
	CALL	1,[SIXBIT /EXIT/]
	HALT	.
GETDCT:	JUMPLE	KPTR,PLAINW
	MOVE	DPTR,MULKY(KPTR)
	HLRZ	A,DICT+1(DPTR)
	JUMPN	A,GOTML1
	HRRZ	A,DICT+2(DPTR)
	JUMPN	A,GOTML2
BACKUP:	SUBI	KPTR,1
	JUMPL	KPTR,PLAINW
	MOVE	DPTR,MULKY(KPTR)
	HRRZ	A,DICT+2(DPTR)
	JUMPE	A,BACKUP
	JRST	GOTML2
GOTML1:	ADDI	KPTR,1
;	ADDI	RPTR,1
GOTML2:	MOVEM	A,MULKY(KPTR)
	HRRE	C,DICT+1(A)
	JUMPGE	C,GOTON
;	HLRZ	C,DICT+1(A)
;	JUMPGE	C,GOTON
	HLRZ	C,DICT+1(A)
	MOVE	A,C
	JRST	GOTML1

PLAINW:	JUMPL	KPTR,NXTONE
	SETZ	KPTR,
	MOVE	A,MULKY(KPTR)
	HLRZ	C,DICT+1(A)
	JUMPN	C,GETNXT
NXTONE:	SETZ	KPTR,
	MOVE	A,MULKY(KPTR)
	ADDI	A,2
	HLRZ	C,DICT(A)
	CAIE	A,2
	JUMPE	C,OUTFIL
	MOVEM	A,MULKY(KPTR)
	MOVE	C,A
	HRRE	A,DICT+1(C)
	JUMPGE	A,GOTON
	HLRZ	C,DICT+1(C)
GETNXT:	ADDI	KPTR,1
	MOVEM	C,MULKY(KPTR)
	MOVE	A,C
	HRRE	A,DICT+1(C)
	JUMPGE	A,GOTON
	HLRZ	C,DICT+1(C)
	JRST	GETNXT
GOTON:	POPJ	P,

	END	COUNTR